home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Libraries / Animation Routines / A - Basic Routines next >
Encoding:
Text File  |  1993-03-31  |  3.4 KB  |  118 lines  |  [TEXT/PJMM]
  1. {Andrew, author of Maelstrom, provided me with the following routines that help create color and noncolor ports and erase}
  2. {them from memory.  In order to use the routines provided in CellusoftAnimations, you must have this unit before the}
  3. {Cellusoft animations unit but you do not need to understand how these routines work or how to call them.}
  4. {CellusoftAnimations.p makes the task of creating ports and handling them a very easy task.}
  5.  
  6. {The following code may be used and distributed freely.  Many thanks to the author of the hit game Maelstrom!}
  7.  
  8. unit BasicRoutines;
  9.  
  10. interface
  11.  
  12.     function NewOffscreenPort (r: Rect): GrafPtr;
  13.     procedure DisposeOffscreenPort (offscreen: GrafPtr);
  14.     function NewOffScreenColorPort (bitrect: Rect): CGrafPtr;            {This long function creates the PixMaps.}
  15.     procedure DisposeOffScreenColorPort (thePix: CGrafPtr);
  16.  
  17. implementation
  18.  
  19.     function NewOffscreenPort (r: Rect): GrafPtr;
  20.         var
  21.             offscreen: GrafPtr;
  22.             savePort: GrafPtr;
  23.             baseAddr: Ptr;
  24.             rowBytes: Integer;
  25.     begin
  26.         GetPort(savePort);
  27.  
  28.         offscreen := GrafPtr(NewPtr(sizeof(GrafPort)));
  29.         if offscreen <> nil then
  30.             begin
  31.                 OpenPort(offscreen);
  32.                 rowBytes := ((r.right - r.left + 15) div 16) * 2;
  33.                 baseAddr := NewPtr(rowBytes * Longint((r.bottom - r.top)));
  34.  
  35.                 if baseAddr <> nil then
  36.                     begin
  37.                         offscreen^.portBits.rowBytes := rowBytes;
  38.                         offscreen^.portBits.baseAddr := baseAddr;
  39.                         offscreen^.portRect := r;
  40.                         offscreen^.portBits.bounds := r;
  41.                         RectRgn(offscreen^.clipRgn, r);
  42.                         RectRgn(offscreen^.visRgn, r);
  43.                     end
  44.                 else
  45.                     begin
  46.                         ClosePort(offscreen);
  47.                         DisposPtr(Ptr(offscreen));
  48.                         offscreen := nil;
  49.                     end
  50.             end;
  51.  
  52.         SetPort(savePort);
  53.         NewOffscreenPort := offscreen;
  54.     end;
  55.  
  56.     procedure DisposeOffscreenPort (offscreen: GrafPtr);
  57.     begin
  58.         DisposPtr(offscreen^.portBits.baseAddr);
  59.         ClosePort(offscreen);
  60.         DisposPtr(Ptr(offscreen));
  61.  
  62.     end;
  63.  
  64.     function NewOffScreenColorPort (bitrect: Rect): CGrafPtr;            {This long function creates the PixMaps.}
  65.         var
  66.             prowbytes: longint;
  67.             width, height: longint;
  68.             bufferaddr: Ptr;
  69.             oldDev, deepdevicehdl: GDHandle;
  70.             pixdepth: longint;
  71.             buffersize: Longint;
  72.             aport: CGrafPtr;
  73.             saveport: GrafPtr;
  74.             prect: Rect;
  75.  
  76.     begin
  77.         aport := nil;
  78.         prect := bitrect;
  79.         OffsetRect(prect, -prect.left, -prect.top);
  80.         oldDev := GetGDevice;
  81.         deepdevicehdl := GetMaxDevice(bitrect);
  82.         SetGDevice(deepdevicehdl);
  83.         pixdepth := deepdevicehdl^^.gdPMap^^.pixelSize;
  84.         width := bitrect.right - bitrect.left;
  85.         height := bitrect.bottom - bitrect.top;
  86.         prowbytes := Round((((pixdepth * width) + 15) / 16) * 2);
  87.         buffersize := height * prowbytes;
  88.         bufferaddr := NewPtr(buffersize);
  89.         prowbytes := prowbytes + $8000;
  90.         if (MemError = noErr) then
  91.             begin
  92.                 GetPort(saveport);
  93.                 aport := CGrafPtr((NewPtr(sizeof(CGrafPort))));
  94.                 OpenCPort(aport);
  95.                 aport^.portPixMap^^.baseAddr := bufferaddr;
  96.                 aport^.portPixMap^^.rowBytes := prowbytes;
  97.                 aport^.portPixMap^^.bounds := prect;
  98.                 aport^.visRgn^^.rgnBBox := prect;   {LC Call}
  99.                 SetPort(GrafPtr(aport));
  100.                 PortSize(width, height);
  101.                 ClipRect(prect);
  102.                 CopyRgn(aport^.clipRgn, aport^.visRgn);
  103.                 SetPort(saveport);
  104.             end;
  105.         SetGDevice(oldDev);
  106.         NewOffScreenColorPort := aport;
  107.     end;  { -- CreatePixMap }
  108.  
  109.  
  110.  
  111.     procedure DisposeOffScreenColorPort (thePix: CGrafPtr);        {This procedure destroys the offscreen pixmap passed to it }
  112.     begin
  113.         DisposPtr(thePix^.portPixMap^^.baseAddr);
  114.         CloseCPort(thePix);
  115.         DisposPtr(Ptr(thePix));
  116.     end;  { -- KillPixMap }
  117.  
  118. end.